!!MP	inlines.f
	program hotlis
c
c   Hotlist2HTML
c
c   Read the NCSA Mosaic (up from V. 1.0.2) Hotlist and generates
c   a HTML page from it. Output is written to a user selectable file.
c
c   Compilation of this program requires the Language Systems Fortran 3.0
c   compiler or a later Version, running under MPW 3.2.3.
c   Furthermore, System 7 Toolbox routines are called. 
c
c   Lutz Weimann   Version 0.7     17.6.94
c
	implicit none
c
!!I		Standardfile.f
c
	integer outunit
	parameter (outunit=20)
	integer MaxListLength
	parameter(MaxListLength=255)
c
	Integer ActualListLength, Mode
	string*8 HTMLBrowser
	integer*2 refnum, vRefNum, err
	pointer /ptr/ menuh, urlsh, hotlisth
	record /SFTypeList/ MyTypes
	record /StandardFileReply/ ReplyRecord
	string*255 HotlistName, thestring
	string*255 Menu(MaxListLength), URLs(MaxListLength)
c
	call InitialAboutBox(Mode)
c
	MyTypes.OSTy(0)='HOTL'
	MyTypes.OSTy(1)='HLST'
	Call StandardGetFile(nil,Int2(2),MyTypes,ReplyRecord)
	if (.not.ReplyRecord.sfGood) stop 'Hotlist selection canceled!'
	HotlistName = ReplyRecord.sfFile.name
c
	refnum = FSpOpenResfile(ReplyRecord.sfFile,Int1(1))
	if (ResError().ne.0) stop 'OpenResfile: Cannot open Hotlist!'
c
	call UseResFile(refnum)
	if (ResError().ne.0) stop 'UseResFile failed!'
c
	if (ReplyRecord.sfType.F .eq. 'HOTL') then
c
		HTMLBrowser='Mosaic'
		thestring = 'Menu'
		menuh = GetNamedResource('STR#',thestring)
		if (ResError().ne.0) stop 'Cant find STR# Resource Menu!'
c
		thestring = 'URLs'
		urlsh = GetNamedResource('STR#',thestring)
		if (ResError().ne.0) stop 'Cant find STR# Resource URLs!'
c
		call ReadInMosaicHotlist(%val(menuh^.p), %val(urlsh^.p),
     $                           MaxListLength, Menu, URLs,
     $                           ActualListLength)
c
	else if (ReplyRecord.sfType.F .eq. 'HLST') then
c
		HTMLBrowser='MacWeb'
		thestring = 'Hotlist'
		hotlisth = GetNamedResource('STR#',thestring)
		if (ResError().ne.0) stop 'Cant find STR# Resource Hotlist!'
c
		call ReadInMacWebHotlist(%val(hotlisth^.p), MaxListLength,  
     $                           Menu, URLs, ActualListLength)
c
	else
		stop 'Input file has an unknown type!'
	endif
c
	if (Mode.eq.0) Call HotlistSort(ActualListLength, Menu, URLs)
c
	call F_SetDefaultFileName (HotlistName//'.html')
	open (outunit,file=*'Save HTML page as:',status='new',
     $    creator='ttxt')
c
	call WriteHTMLfile(outunit, HotlistName, ActualListLength,
     $                 Menu, URLs, HTMLBrowser)
c
	close(outunit)
 	call CloseResFile(refnum)
	if (ResError().ne.0) stop 'CloseResFile failed!'
	end
c
c
	subroutine ReadInMosaicHotlist(Menu, URLs, MaxListLength,
     $                             MenuStor, URLsStor, ActListLength)
	implicit none
	integer*1 Menu(*), URLs(*)
	integer MaxListLength, ActListLength
	string*255 MenuStor(MaxListLength), URLsStor(MaxListLength)
c
	integer numMenu, numURLs, ptrMenu, ptrURLs, lMenu, lURLs,
     $      i, j, temp1, temp2
	character*255 CharMenuBuf, CharURLsBuf
	integer*1 IntMenuBuf(255), IntURLsBuf(255)
	equivalence (CharMenuBuf,IntMenuBuf), (CharURLsBuf,IntURLsBuf)
	character*255 Message
c
	
	temp1 = Menu(1)
	if (temp1.lt.0) temp1=256+temp1
	temp2 = Menu(2)
	if (temp2.lt.0) temp2=256+temp2
	numMenu = temp1*256+temp2
	temp1 = URLs(1)
	if (temp1.lt.0) temp1=256+temp1
	temp2 = URLs(2)
	if (temp2.lt.0) temp2=256+temp2
	numURLs = temp1*256+temp2
	if (numMenu.ne.numURLs) then
		Message = 'Different number of menuitems and URLs found.'//
     $            'I generate a list of the lower number length'
		call AlertBox(Message)
	endif
	ActListLength = min(numMenu, numURLs)
	if (ActListLength.gt.MaxListLength) then
		write(Message,1001) ActListLength, MaxListLength
		call AlertBox(Message)
		ActListLength = MaxListLength
	endif
	ptrMenu = 3
	ptrURLs = 3
	do i=1,ActListLength
		lMenu = Menu(ptrMenu)
		if (lMenu.lt.0) lMenu=256+lMenu
		do j=1,lMenu
			IntMenuBuf(j) = Menu(ptrMenu+j)
		enddo
		ptrMenu = ptrMenu+lMenu+1
		MenuStor(i) = CharMenuBuf(1:lMenu)
		lURLs = URLs(ptrURLs)
		if (lURLs.lt.0) lURLs=256+lURLs
		do j=1,lURLs
			IntURLsBuf(j) = URLs(ptrURLs+j)
		enddo
		ptrURLs = ptrURLs+lURLs+1
		URLsStor(i) = CharURLsBuf(1:lURLs)
	enddo
	return
c
1001	format('Your Hotlist has ',a,' entries - too much for me.',
     $         'Only the first ',a,' entries are converted to HTML')
	end
c
c
	subroutine ReadInMacWebHotlist(Hotlist, MaxListLength,
     $                             MenuStor, URLsStor, ActListLength)
	implicit none
	integer*1 Hotlist(*)
	integer MaxListLength, ActListLength
	string*255 MenuStor(MaxListLength), URLsStor(MaxListLength)
c
	integer numItems, ptrMenu, ptrURLs, lMenu, lURLs,
     $      i, j, temp1, temp2
	character*255 CharMenuBuf, CharURLsBuf
	integer*1 IntMenuBuf(255), IntURLsBuf(255)
	equivalence (CharMenuBuf,IntMenuBuf), (CharURLsBuf,IntURLsBuf)
	character*255 Message
c
	temp1 = Hotlist(1)
	if (temp1.lt.0) temp1=256+temp1
	temp2 = Hotlist(2)
	if (temp2.lt.0) temp2=256+temp2
	numItems = temp1*256+temp2
	ActListLength = NumItems/2
	if (ActListLength*2.ne.NumItems) then
		Message = 'Inconsistent number of menu titles and URLs '//
     $            'in the MacWeb Hotlist. Something may be '//
     $            'missed within the HTML output.'
		call AlertBox(Message)
	endif
	if (ActListLength.gt.MaxListLength) then
		write(Message,1001) ActListLength, MaxListLength
		call AlertBox(Message)
		ActListLength = MaxListLength
	endif
	ptrMenu = 3
	do i=1,ActListLength
		lMenu = Hotlist(ptrMenu)
		if (lMenu.lt.0) lMenu=256+lMenu
		do j=1,lMenu
			IntMenuBuf(j) = Hotlist(ptrMenu+j)
		enddo
		ptrURLs = ptrMenu+lMenu+1
		MenuStor(i) = CharMenuBuf(1:lMenu)
		lURLs = Hotlist(ptrURLs)
		if (lURLs.lt.0) lURLs=256+lURLs
		do j=1,lURLs
			IntURLsBuf(j) = Hotlist(ptrURLs+j)
		enddo
		ptrMenu = ptrURLs+lURLs+1
		URLsStor(i) = CharURLsBuf(1:lURLs)
	enddo
	return
c
1001  format('Your Hotlist has ',a,' entries - too much for me.',
     $         'Only the first ',a,' entries are converted to HTML')
	end
c
c
	subroutine WriteHTMLfile(outunit, HotlistFileName, ActualListLength,
     $                       Menu, URLs, HTMLBrowser)
	implicit none
	integer outunit
	string*255 HotlistFileName
	integer ActualListLength
	string*255 Menu(ActualListLength), URLs(ActualListLength)
	string*8 HTMLBrowser
c
	string*255 Message
	character*9 datestring
	integer i
c
	write(outunit,1001) HotlistFileName, HotlistFileName
	do i=1,ActualListLength
		write(outunit,1002) URLs(i), Menu(i)
	enddo
	call date(datestring)
	write(outunit,1003) HTMLBrowser, HotlistFileName, datestring
	return
c
1001  format('<TITLE>',a,'</TITLE>',/,'<H1>',a,'</H1>','<UL>')
1002  format('<LI> <A HREF= "',a,'">',a,'</A>')
1003  format('</UL>',/,'<ADDRESS>Generated from ',a,'-Hotlist ',a,
     $       ' at ',a,'</ADDRESS>',/)
	end
c
c
	Subroutine HotlistSort(ActualListLength, Menu, URLs)
	implicit none
c
c	A simple (and not most quick) sort routine.
c	Sorts the Hotlist lexically according to the names of the MenuItems.
c
	integer ActualListLength
	string*255 Menu(ActualListLength), URLs(ActualListLength)
c
	string*255 MenuLow, URLsLow
	integer i,j,indexLow
c
	do i=1,ActualListLength-1
		MenuLow = Menu(i)
		indexLow = i
		do j=i+1,ActualListLength
			if (Menu(j).lt.MenuLow) then
				MenuLow = Menu(j)
				indexLow = j
			endif
		enddo
		URLsLow = URLs(indexLow)
		Menu(indexLow) = Menu(i)
		URLs(indexLow) = URLs(i)
		Menu(i) = MenuLow
		URLs(i) = URLsLow
	enddo
	return
	end
c
c
	Subroutine InitialAboutBox(Mode)
	implicit none
	integer Mode
c
!!I	Dialogs.f
!!I	Events.f
c
	integer*2 AboutDialogID
	parameter (AboutDialogID=32002)
c
	record /EventRecord/ theEvent
	record /DialogRecord/ AboutDialog
	record /DialogPtr/ AboutDialogPtr
	integer*2 itemhit
	logical status
c
	call InitDialogs(nil)
	AboutDialogPtr = GetNewDialog(AboutDialogID, %ref(AboutDialog), -1)
c
	do while (.not.GetNextEvent(mDownMask,theEvent))
		if (GetNextEvent(updateMask,theEvent)) then
			if (.not.IsDialogEvent(theEvent)) cycle
			status = DialogSelect(theEvent,%ref(AboutDialogPtr),%ref(itemhit))
		endif
	enddo
C   Mode = 0: Shift key not pressed;  Mode=1: Shift key pressed
	Mode = IAND(theEvent.modifiers,Z'200')
	if (Mode.ne.0) Mode=1
	call DisposDialog(AboutDialogPtr)
	return
	end
	
	
	
	